;;
;; defines base definitions for oali
;;

(in-package :oali.proto)


;; parser context class
(defclass parser-context ()
  ((funcs-map :initform (make-hash-table) :reader funcs-map)))



;; function definition
(defclass func-def ()
  ((lambda-list :initform (error 'ctor-error :entity 'lambda-list)
		:initarg :lambda-list :reader lambda-list)
   (lambda-func :initform (error 'ctor-error :entity 'lambda-func)
		:initarg :lambda-func :reader lambda-func)))


;; generic func map accessor
(defgeneric funcs (context))

(defmethod funcs ((context parser-context))
  (funcs-map context))

;;
;; wrapper for all the introduced function calls
;;

(defun wrapped-call (context func-id &rest args)
  (let ((func-def (gethash func-id (funcs context))))
    (unless func-def (error 'not-found :entity func-id))
    (funcall (lambda-func func-def) context args)))


;; generate code for the generic builtins

(defgeneric gen-binary-op (context op args))



;; Builtins

(defun builtin-+ (context args)
  (gen-binary-op context '+ args))

(defun builtin-* (context args)
  (gen-binary-op context '* args))



;;
;; helpers
;;

(defun add-func (context func-id func-obj)
  (let ((func-map (funcs context)))
    (if (gethash func-id func-map) (error 'duplicate-definition :entity func-id))
    (setf (gethash func-id func-map) func-obj)))


(defun transform-expr (expr)
  "do transform incoming s-exp to (wrapped-call 'context @`s-exp),
incoming atom just left as it is"
  (if (consp expr)
      ;; transform s-expression
      `(wrapped-call context ',(car expr)
		     ,@(loop for arg in (cdr expr) collect (transform-expr arg)))
      ;; leave atom as it is
      expr))

(defun construct-func-form (arglist body)
  "produces from the function form given a lambda form that accepts
context and the original arguments"
  (list
   ;; produce a form like the following:
   ;; (lambda (context args) (destructuring-bind (..arglist..) args ...))
   'lambda '(context args)
   (append (list 'destructuring-bind arglist 'args)
	   (loop for expr in body collect (transform-expr expr)))))

(defun accept-func (context funcdef)
  "handles incoming function definition"
  (destructuring-bind (func-keyword func-id (&rest arglist) &rest body) funcdef
    (unless (eq func-keyword 'func)
      (error 'syntax-error :reason "function keyword is omitted" :entity funcdef))
    ;; arglist shall not contain variable "context"
    (dolist (a arglist)
      (if (or (eq 'context a) (eq 'args a))
	  (error 'syntax-error :entity a :where arglist
		 :reason "context/args names shall not occur in the arguments list")))
    (let ((func-form (construct-func-form arglist body)))
      ;; add another function
      (add-func
       context func-id
       (make-instance 'func-def :lambda-list arglist :lambda-func (eval func-form))))))


(defun add-builtins (parser-context)
  (flet ((add (func-id lambda-list lambda-func)
	   (add-func parser-context func-id
		     (make-instance 'func-def
				    :lambda-list lambda-list
				    :lambda-func lambda-func))))
    
    (add '+ '(&rest args) #'builtin-+)
    (add '* '(&rest args) #'builtin-*)
      
    t))
